Carousel Volume 2 #1/carousel.iso/mactosh/lang/p_image1.sit/LSP Source/Image.p

Text File | 1989-07-29 | 55.3 KB | 2,340 lines

program Image;

{Image is a program for the Macintosh II for acquiring, enhancing, analyzing, editing,}
{pseudocoloring, printing, and animating grayscale and color images.}


{Version 1.16 , 21-July-1989}


{Developed using Lightspeed Pascal 2.0 and Turbo Pascal Numerical Toolbox Methods.}


{Author :}

{Wayne Rasband}
{National Institutes of Health}
{Bethesda , MD}

{BitNet: wsr@nihcu}
{Internet: [e-mail]}
{CompuServe: 76067,3454}


    uses
        QuickDraw, OSIntf, ToolIntf, PrintTraps, globals, Utilities, Initialization, FileUnit, Analysis, Graphics, edit, Functions, Camera, User;

{$I-}


{PROCEDURE MacsBug; inline $a9ff;}


    procedure InvertPalette;
        var
            TempRed, TempGreen, TempBlue: ColorArrayX;
            i, LastColor: integer;
            TempTable: MyCSpecArray;
    begin
        with info^ do begin
                if LutMode = ColorPalette then begin
                        TempRed := RedX;
                        TempGreen := GreenX;
                        TempBlue := BlueX;
                        LastColor := ncolors - 1;
                        for i := 0 to LastColor do begin
                                RedX[i] := TempRed[LastColor - i];
                                GreenX[i] := TempGreen[LastColor - i];
                                BlueX[i] := TempBlue[LastColor - i];
                            end;
                        UpdateColors;
                    end
                else begin
                        TempTable := cTable;
                        for i := 1 to 254 do
                            cTable[i] := TempTable[255 - i];
                        LoadLUT(cTable);
                    end;
            end; {with}
    end;


    procedure UpdateOptionsMenu;
        var
            CheckIt: boolean;
            i: integer;
    begin
        case info^.LUTMode of
            GrayScale, CustomGrayscale:
                CheckOnOffItem(OptionsMenuH, 5, 5, 8);
            ColorPalette:
                CheckOnOffItem(OptionsMenuH, 6, 5, 8);
            AppleDefault:
                CheckOnOffItem(OptionsMenuH, 7, 5, 8);
            Spectrum:
                CheckOnOffItem(OptionsMenuH, 8, 5, 8);
            Custom:
                for i := 5 to 8 do
                    CheckItem(OptionsMenuH, i, false);
        end;
        SetMenuItem(OptionsMenuH, 12, info <> NoInfo);
        CheckIt := Info^.ScaleToFitWindow;
        CheckItem(OptionsMenuH, 12, CheckIt);
        CheckItem(OptionsMenuH, 13, Thresholding);
    end;


    procedure UpdateFunctionsMenu;
        var
            ShowItems: boolean;
            i: integer;
    begin
        ShowItems := Info <> NoInfo;
        for i := SmoothItem to ConvolveItem do
            SetMenuItem(FunctionsMenuH, i, ShowItems);
        for i := PhotoModeItem to ChangeItem do
            SetMenuItem(FunctionsMenuH, i, ShowItems);
        with info^ do begin
                SetMenuItem(FunctionsMenuH, SortItem, (LutMode = custom) or (LutMode = spectrum));
                SetMenuItem(FunctionsMenuH, UnZoomItem, ShowItems and ((magnification <> 1.0) or ScaleToFitWindow));
            end;
        SetMenuItem(FunctionsMenuH, SetVideoItem, FrameGrabber <> NoFrameGrabber);
    end;


    procedure SetNumberOfColors;
        var
            TempNColors: integer;
    begin
        TempNColors := GetInt('Number Of Colors(1..32):', info^.ncolors);
        if (TempNColors <= 32) and (TempNColors > 0) then begin
                info^.nColors := TempNColors;
                CheckColorWidth;
                UpdateColors;
            end
        else if TempNColors <> -MaxInt then
            beep;
    end;


    procedure SetNumberOfExtraColors;
        var
            TempNColors: integer;
    begin
        TempNColors := GetInt('Number Of ExtraColors(0..6):', nExtraColors);
        if (TempNColors <= 6) and (TempNColors >= 0) then begin
                nExtraColors := TempNColors;
                RedrawCLUTWindow;
            end
        else if TempNColors <> -MaxInt then
            beep;
    end;


    procedure ChangeColor;
  {Changes all the pixels in the current selection from the foreground}
{   color(index) to the background color(index).}
        var
            i, value: integer;
            table: LookupTable;
    begin
        for i := 0 to 255 do begin
                value := i;
                if value = ForegroundColor then
                    value := BackgroundColor;
                table[i] := value;
            end;
        ApplyTable(table);
    end;


    function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean;
{ simple filter proc for about box -- must be at top level! % }
    begin
        if (event.what in [MouseDown, KeyDown, AutoKey]) then begin
                AboutFilter := true;
                ItemHit := OK;
            end
        else begin
                AboutFilter := false;
                ItemHit := 0;
            end;
    end;


    procedure AboutUProc (d: DialogPtr; item: integer);
{ About box user proc -- must be at top level!}
        var
            s: str255;
            saveport: grafptr;
            VersInfo: str255;
    begin
        getport(saveport);
        setport(d);
        if (item = MemItem) then begin
                NumToString(FreeMem div 1024, s);
                s := concat(s, 'K free');
                DrawSItem(MemItem, Geneva, 9, d, s);
            end
        else if (item = VersItem) then begin
                RealToString(version / 100.0, 4, 2, VersInfo);
                VersInfo := concat('Version ', VersInfo);
                DrawSItem(VersItem, Geneva, 9, d, VersInfo);
            end;
        setport(saveport);
    end;


    procedure DoAbout;
  {About Box by David Powell}
        var
            i: integer;
            d: dialogptr;
            midscreen: point;
            saveport: grafptr;
            r: rect;
            h: handle;
            itype: integer;
    begin
        getport(saveport);
        d := getnewdialog(AboutID, nil, pointer(-1));
        if (d <> nil) then begin
                SetPort(d);
                GetDItem(d, VersItem, itype, h, r);
                SetDItem(d, VersItem, itype, @AboutUProc, r);
                GetDItem(d, MemItem, itype, h, r);
                SetDItem(d, MemItem, itype, @AboutUProc, r);
                ShowWindow(d);
                repeat
                    ModalDialog(@aboutfilter, i);
                until (i = OK);
                DisposDialog(d);
                FlushEvents(EveryEvent, 0);
            end;
        setport(saveport);
    end;


    procedure DoMoreOptions;
        const
            WidthID = 4;
            HeightID = 6;
            FramesID = 8;
            InvertID = 9;
            BufferSizeID = 10;
            MaxScionWidthID = 14;
            WandAutoMeasureID = 16;
            WandAutoNumberID = 17;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveInvert, SaveWandMeasure, SaveWandNumber: boolean;
            SaveWidth, SaveHeight, SaveFrames, SaveMaxWidth: integer;
            SaveBufferSize: LongInt;
    begin
        InitCursor;
        SaveWidth := NewPicWidth;
        SaveHeight := NewPicHeight;
        SaveFrames := nFrames;
        SaveInvert := InvertVideo;
        SaveBufferSize := BufferSize;
        SaveMaxWidth := MaxScionWidth;
        SaveWandMeasure := WandAutoMeasure;
        SaveWandNumber := WandAutoNumber;
        mylog := GetNewDialog(6000, nil, pointer(-1));
        SetDNum(MyLog, WidthID, NewPicWidth);
        SetDNum(MyLog, HeightID, NewPicHeight);
        SetDNum(MyLog, FramesID, nFrames);
        SetDNum(MyLog, BufferSizeID, BufferSize div 1024);
        SetDNum(MyLog, MaxScionWidthID, MaxScionWidth);
        if InvertVideo then
            SetDialogItem(mylog, InvertID, 1);
        if WandAutoMeasure then
            SetDialogItem(mylog, WandAutoMeasureID, 1);
        if WandAutoNumber then
            SetDialogItem(mylog, WandAutoNumberID, 1);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = WidthID then begin
                    NewPicWidth := GetDNum(MyLog, WidthID);
                    if (NewPicWidth < 0) or (NewPicWidth > 2048) then begin
                            NewPicWidth := SaveWidth;
                            SetDNum(MyLog, WidthID, NewPicWidth);
                        end;
                end;
            if item = HeightID then begin
                    NewPicHeight := GetDNum(MyLog, HeightID);
                    if (NewPicHeight < 0) or (NewPicHeight > 2048) then begin
                            NewPicHeight := SaveHeight;
                            SetDNum(MyLog, HeightID, NewPicHeight);
                        end;
                end;
            if item = FramesID then begin
                    nFrames := GetDNum(MyLog, FramesID);
                    if (nFrames < 0) or (nFrames > 128) then begin
                            nFrames := SaveFrames;
                            SetDNum(MyLog, FramesID, nFrames);
                        end;
                end;
            if item = InvertID then begin
                    StopDigitizing;
                    InvertVideo := not InvertVideo;
                    SetDialogItem(mylog, InvertID, ord(InvertVideo));
                end;
            if item = WandAutoMeasureID then begin
                    WandAutoMeasure := not WandAutoMeasure;
                    SetDialogItem(mylog, WandAutoMeasureID, ord(WandAutoMeasure));
                end;
            if item = WandAutoNumberID then begin
                    WandAutoNumber := not WandAutoNumber;
                    SetDialogItem(mylog, WandAutoNumberID, ord(WandAutoNumber));
                end;
            if item = BufferSizeID then begin
                    BufferSize := GetDNum(MyLog, BufferSizeID) * 1024;
                    if BufferSize < 1 then begin
                            beep;
                            BufferSize := 1;
                            SetDNum(MyLog, BufferSizeID, BufferSize);
                        end;
                end;
            if item = MaxScionWidthID then begin
                    MaxScionWidth := BitAnd(GetDNum(MyLog, MaxScionWidthID), $fffc);
                    if (MaxScionWidth < 0) or (MaxScionWidth > 640) then begin
                            beep;
                            MaxScionWidth := SaveMaxWidth;
                            SetDNum(MyLog, MaxScionWidthID, MaxScionWidth);
                        end;
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if NewPicWidth < 32 then
            NewPicWidth := 32;
        if odd(NewPicWidth) then
            NewPicWidth := NewPicWidth + 1;
        if NewPicHeight < 32 then
            NewPicHeight := 32;
        if nFrames < 2 then
            nFrames := 2;
        if item = cancel then begin
                NewPicWidth := SaveWidth;
                NewPicHeight := SaveHeight;
                nFrames := SaveFrames;
                InvertVideo := SaveInvert;
                BufferSize := SaveBufferSize;
                MaxScionWidth := SaveMaxWidth;
                WandAutoMeasure := SaveWandMeasure;
                WandAutoNumber := SaveWandNumber;
            end;
        if BufferSize <> SaveBufferSIze then
            PutMessage('You must "Record Preferences" and restart before the Undo and Clipboard buffer ', 'size change will take effect.', '');
    end;


    procedure CheckWindowsMenuItem;
        var
            i, kind: integer;
            fwptr: WindowPtr;
    begin
        SetMenuItem(WindowsMenuH, 1, nPics > 1);
        for i := 3 to 9 do
            CheckItem(WindowsMenuH, i, false);
        for i := 1 to nPics do
            CheckItem(WindowsMenuH, nItems + i, false);
        fwptr := FrontWindow;
        kind := WindowPeek(fwptr)^.WindowKind;
        if kind < 0 then
            exit(CheckWindowsMenuItem); {System Window}
        case kind of
            ToolKind:
                CheckItem(WindowsMenuH, 3, true);
            GrayMapKind:
                CheckItem(WindowsMenuH, 4, true);
            LUTKind:
                CheckItem(WindowsMenuH, 5, true);
            ResultsKind:
                CheckItem(WindowsMenuH, 6, true);
            HistoKind:
                CheckItem(WindowsMenuH, 7, true);
            ProfilePlotKind, CalibrationPLotKind:
                CheckItem(WindowsMenuH, 8, true);
            PasteControlKind:
                CheckItem(WindowsMenuH, 9, true);
            PicKind:
                begin
                    i := info^.PicNum;
                    if i > MaxPicsInMenu then
                        i := MaxPicsInMenu;
                    CheckItem(WindowsMenuH, nItems + i, true);
                end;
            otherwise
        end;
    end;


    procedure DoClose;
        var
            ignore: integer;
            fwptr: WindowPtr;
            kind: integer;
    begin
        fwptr := FrontWindow;
        kind := WindowPeek(fwptr)^.WindowKind;
        if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) then begin
                StopDigitizing;
                ignore := CloseAWindow(fwptr);
            end;
    end;


    procedure ShowNextWindow;
        var
            n: integer;
    begin
        n := info^.PicNum + 1;
        if n > nPics then
            n := 1;
        SelectWindow(PicWindow[n]);
    end;


    procedure DoMenuEvent (MenuChoice: LongInt);
        var
            MenuID, MenuItem, i, ignore: integer;
            name, str: str255;
            dna: integer;
            ItemName: str255;
            FontName: str255;
            ok, isSelection: boolean;
            NewStyle: StyleItem;
    begin
        MenuID := HiWord(MenuChoice);
        MenuItem := LoWord(MenuChoice);
        case MenuID of

            AppleMenu:
                begin
                    if MenuItem = 1 then
                        DoAbout
                    else begin
                            GetItem(GetMHandle(AppleMenu), MenuItem, name);
                            ignore := OpenDeskAcc(name)
                        end;
                end;

            FileMenu:
                begin
                    with info^ do
                        isSelection := RoiShowing and (RoiType = RectRoi);
                    case MenuItem of
                        1:
                            begin
                                ok := NewPicWindow('Untitled', NewPicWidth, NewPicHeight);
                                if info^.PicSize > UndoBufSize then
                                    PutWarning;
                            end;
                        2:
                            begin
                                StopDigitizing;
                                GetFile;
                            end;
                        3:
                            ImportFile;
                        4:
                            DoClose;
       {5:-}
                        6:
                            if info^.PictureType <> Camera then {save}
                                SaveFile
                            else begin
                                    StopDigitizing;
                                    SaveCameraWindow;
                                end;
                        7:
                            if isSelection then  {save as TIFF}
                                SaveSelection(false)
                            else if info^.PictureType <> camera then
                                SaveTiffAs(0, 0, false)
                            else begin
                                    StopDigitizing;
                                    SaveCameraWindow;
                                end;
                        8:
                            if isSelection then
                                SavePICTAs(true)
                            else
                                SavePICTAs(false);
                        9:
                            SaveSettings;
       {10:-}
                        11:
                            RevertToSaved;
                        12:
                            begin
                                StopDigitizing;
                                Duplicate(false);
                            end;
                        13:
                            GetInfo;
       {14:-}
                        15:
                            SetHalftone;
                        16:
                            DoPageSetup;
                        17:
                            Print(true);
       {18:-}
                        19:
                            begin
                                SavingOutline := true;
                                SavePICTAs(false);
                            end;
                        20:
                            SavePalette;
       {21:-}
                        22:
                            finished := true;
                    end;
                end;

            EditMenu:
                begin
                    GetItem(GetMHandle(EditMenu), MenuItem, ItemName);
                    if not SystemEdit(MenuItem - 1) then
                        case MenuItem of
                            1:
                                if info <> NoInfo then begin
                                        case WhatToUndo of
                                            UndoMeasurement:
                                                UndoLastMeasurement;
                                            UndoContrastEnhancement, UndoEqualization:
                                                begin
                                                    ResetGrayMap;
                                                    WhatToUndo := NothingToUndo;
                                                end;
                                            UndoZoom:
                                                begin
                                                    DeZoom;
                                                    if info^.magnification < 2 then
                                                        WhatToUndo := NothingToUndo;
                                                end;
                                            UndoOutLine:
                                                begin
                                                    undo;
                                                    if WandAutoMeasure then
                                                        UndoLastMeasurement;
                                                    WhatToUndo := NothingToUndo;
                                                    UpdatePicWindow;
                                                end;
                                            otherwise
                                                begin
                                                    if UndoFromClip then
                                                        OpPending := false;
                                                    if not OpPending then
                                                        undo;
                                                    WhatToUndo := NothingToUndo;
                                                    if IsInsertionPoint then begin
                                                            InsertionPoint := TextStart;
                                                            TextStr := '';
                                                        end;
                                                    UpdatePicWindow;
                                                    if OpPending and (CurrentOp = PasteOp) then begin
                                                            OpPending := false;
                                                            KillRoi;
                                                        end;
                                                    OpPending := false;
                                                end;
                                        end; {case}
                                    end;
       {2:-}
                            3:
                                DoCut;
                            4:
                                DoCopy;
                            5:
                                begin
                                    StopDigitizing;
                                    DoPaste
                                end;
                            6:
                                DoClear;
      {7:---}
                            8, 9, 10:
                                SetupOperation(MenuItem);
       {11:-}
                            12:
                                if PasteControl = nil then
                                    ShowPasteControl
                                else
                                    BringToFront(PasteControl);
                            13:
                                begin
                                    StopDigitizing;
                                    SelectAll(true)
                                end;
                            14:
                                ScaleSelection;
       {15:-}
                            16:
                                FlipOrRotate(RotateLeft);
                            17:
                                FlipOrRotate(RotateRight);
                            18:
                                FlipOrRotate(FlipVertical);
                            19:
                                FlipOrRotate(FlipHorizontal);
                            20:
                                RotateAndScale;
      {21:---}
                            22:
                                ShowClipboard;
                        end;
                end;

            OptionsMenu:
                begin
                    case MenuItem of
                        1:
                            InvertPalette;
                        2:
                            SetNumberOfColors;
                        3:
                            SetNumberOfExtraColors;
       {4:---}
                        5:
                            ResetGrayMap;
                        6:
                            UpdateColors;
                        7:
                            ok := LoadCLUTResource(AppleDefaultCLUT);
                        8:
                            Load256ColorCLUT;
       {9:---}
                        10:
                            DoProfilePlotOptions;
                        11:
                            DoMoreOptions;
                        12:
                            ScaleToFit;
                        13:
                            if Thresholding then
                                StopThresholding
                            else
                                StartThresholding;
                    end;
                end;

            FunctionsMenu:
                begin
                    SetupUndo;
                    case MenuItem of
                        SmoothItem:
                            if OptionKeyDown then
                                Filter(UnweightedAvg, true)
                            else
                                Filter(WeightedAvg, true);
                        SharpenItem:
                            Filter(fsharpen, true);
                        EdgeDetectItem:
                            Filter(EdgeDetect, true);
                        ReduceNoiseItem:
                            Filter(ReduceNoise, true);
                        DitherItem:
                            Filter(Dither, true);
                        ConvolveItem:
                            Convolve;
       {---}
                        PhotoModeItem:
                            PhotoMode;
                        AnimateItem:
                            Animate;
                        EnhanceItem:
                            EnhanceContrast;
                        EqualizeItem:
                            EqualizeHistogram;
                        ApplyItem:
                            ApplyLookupTable;
                        ChangeItem:
                            ChangeColor;
                        SortItem:
                            SortPalette;
                        UnZoomItem:
                            Unzoom;
       {--}
                        StartItem:
                            StartDigitizing;
                        AverageItem:
                            AverageFrames;
                        SetVideoItem:
                            SetVideoChannel;
                    end;
                end;

            BinaryMenu:
                case MenuItem of
                    MakeBinaryItem:
                        MakeBinary;
                    ErosionItem:
                        filter(Erosion, true);
                    DilationItem:
                        filter(Dilation, true);
                    OpeningItem:
                        begin
                            filter(Erosion, true);
                            filter(Dilation, false);
                        end;
                    ClosingItem:
                        begin
                            filter(Dilation, true);
                            filter(Erosion, false);
                        end;
                    OutlineItem:
                        filter(OutlineFilter, true);
                    SkeletonizeItem:
                        MakeSkeleton;
                end;

            AnalysisMenu:
                begin
                    SetupUndo;
                    case MenuItem of
                        MeasureItem:
                            Measure;
                        ShowItem:
                            ListResults;
                        OptionsItem:
                            DoMeasurementOptions;
                        HistogramItem:
                            DoHistogram;
                        PlotItem:
                            ColumnAveragePlot;
                        Plot3DItem:
                            Do3DPlot;
       {---}
                        SaveBlankFieldItem:
                            SaveBlankField;
                        SetScaleItem:
                            SetScale;
                        CalibrateItem:
                            Calibrate;
                        ResetItem:
                            ResetCounters;
                        RestoreItem:
                            begin
                                StopDigitizing;
                                RestoreRoi;
                            end;
                        NumberSelectionItem:
                            NumberSelection(nAreas);
                    end;
                end;

            TextMenu:
                begin
                    case MenuItem of
                        LeftItem:
                            TextJust := LeftJust;
                        CenterItem:
                            TextJust := CenterJust;
                        RightItem:
                            TextJust := RightJust;
                        NoBackgroundItem:
                            TextBack := NoBack;
                        WithBackgroundItem:
                            TextBack := WithBack;
                    end;
                    DisplayText;
                    if IsInsertionPoint then
                        UpdatePicWindow;
                    UpdateTextMenu;
                end;

            FontMenu:
                begin
                    GetItem(FontMenuH, MenuItem, FontName);
                    GetFNum(FontName, CurrentFontID);
                    UpdateTextMenu;
                    DisplayText;
                end;

            SizeMenu:
                begin
                    case MenuItem of
                        1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11:
                            CurrentSize := GetFontSize(MenuItem);
                    end;
                    DisplayText;
                    if IsInsertionPoint then
                        UpdatePicWindow;
                    UpdateTextMenu;
                end;

            StyleMenu:
                begin
                    case MenuItem of
                        1:
                            CurrentStyle := [];
                        2, 3, 4, 5, 6:
                            begin
                                case MenuItem of
                                    TxBold:
                                        NewStyle := Bold;
                                    TxItalic:
                                        NewStyle := Italic;
                                    TxUnderLine:
                                        NewStyle := Underline;
                                    TxOutLine:
                                        NewStyle := Outline;
                                    TxShadow:
                                        NewStyle := Shadow;
                                end;
                                if NewStyle in CurrentStyle then
                                    CurrentStyle := CurrentStyle - [NewStyle]
                                else
                                    CurrentStyle := CurrentStyle + [NewStyle];
                            end;
         {7:--}
                        8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18:
                            CurrentSize := GetFontSize(MenuItem);
                    end; {case}
                    DisplayText;
                    if IsInsertionPoint then
                        UpdatePicWindow;
                    UpdateTextMenu;
                end;

            WindowsMenu:
                begin
                    case MenuItem of
                        1:
                            ShowNextWindow;
                        3:
                            SelectWindow(ToolWindow);
                        4:
                            SelectWindow(GrayMapWindow);
                        5:
                            SelectWindow(LUTWindow);
                        6:
                            SelectWindow(ResultsWindow);
                        7:
                            if HistoWindow <> nil then
                                SelectWindow(HistoWindow);
                        8:
                            if PlotWindow <> nil then
                                SelectWindow(PlotWindow);
                        9:
                            if PasteControl <> nil then
                                SelectWindow(PasteControl);
                        10:
                            ; {--}
                        otherwise
                            SelectWindow(PicWindow[MenuItem - NItems]);
                    end;
                end;
            UserMenu:
                DoUserMenuEvent(MenuItem);
            otherwise
        end;
        HiliteMenu(0);
    end;


    procedure DoFreehand (var nVertices: integer; ff: integer; var x, y: xyArray);
        var
            finish: point;
            event: EventRecord;
            wright, wbottom: integer;
    begin
        PenPat(pat[PatIndex]);
        with info^.wptr^.PortRect do begin
                wright := right;
                wbottom := bottom;
            end;
        repeat
            GetMouse(finish);
            with finish do begin
                    if h < 0 then
                        h := 0;
                    if v < 0 then
                        v := 0;
                    if h > wright then
                        h := wright;
                    if v > wbottom then
                        v := wbottom;
                end;
            if nvertices < MaxPolyVertices then
                nvertices := nvertices + 1
            else
                beep;
            with finish do begin
                    LineTo(h - ff, v - ff);
                    x[nvertices] := h;
                    y[nvertices] := v;
                end;
            ticks := TickCount + 4;
            repeat
            until TickCount >= ticks;
        until GetNextEvent(mUpMask, Event);
    end;


    procedure MakePolygon (event: EventRecord);
        var
            Start, Finish, OldFinish, StartingPoint, pt, p1, p2, spt: point;
            r, StartRect, tRect: rect;
            tPort: GrafPtr;
            ticks, MouseUpTime, LastMouseUpTime: LongInt;
            finished, DoubleClick: boolean;
            nvertices, i, ff, wright, wbottom, imag: integer;
            x, y: xyArray;
            TempRgn: RgnHandle;
    begin
        if SelectionMode <> NewSelection then
            TempRgn := NewRgn;
        start := event.where;
        StartingPoint := start;
        Pt2Rect(start, start, StartRect);
        with Info^ do begin
                imag := trunc(magnification + 0.5);
                ff := imag div 2;
                if ff < 1 then
                    ff := 1;
                InsetRect(StartRect, -4 * ff, -4 * ff);
                PenNormal;
                if CurrentTool = PolygonTool then begin
                        PenMode(PatXor);
                        FrameRect(StartRect);
                    end;
                PenSize(imag, imag);
                finish := start;
                finished := false;
                x[1] := StartingPoint.h;
                y[1] := StartingPoint.v;
                nvertices := 1;
            end;
        MoveTo(start.h, start.v);
        if CurrentTool = FreehandTool then begin
                DoFreehand(nVertices, ff, x, y);
                with StartingPoint do
                    LineTo(h - ff, v - ff);
            end
        else begin   {Draw using polygon tool}
                with info^.wptr^.PortRect do begin
                        wright := right;
                        wbottom := bottom;
                    end;
                MouseUpTime := 0;
                repeat
                    repeat
                        OldFinish := finish;
                        GetMouse(finish);
                        with finish do begin
                                if h < 0 then
                                    h := 0;
                                if v < 0 then
                                    v := 0;
                                if h > wright then
                                    h := wright;
                                if v > wbottom then
                                    v := wbottom;
                            end;
                        if not EqualPt(finish, OldFinish) then begin
                                ticks := TickCount;
                                repeat
                                until TickCount <> ticks;
                                MoveTo(start.h - ff, start.v - ff);
                                LineTo(OldFinish.h - ff, OldFinish.v - ff);
                                MoveTo(start.h - ff, start.v - ff);
                                LineTo(finish.h - ff, finish.v - ff);
                            end;
                    until GetNextEvent(mUpMask, Event);
                    LastMouseUpTime := MouseUpTime;
                    MouseUpTime := TickCount;
                    DoubleClick := ((MouseUpTime - LastMouseUpTime) < GetDblTime) and EqualPt(start, finish);
                    if nvertices < MaxPolyVertices then
                        nvertices := nvertices + 1
                    else
                        beep;
                    x[nvertices] := finish.h;
                    y[nvertices] := finish.v;
                    start := finish;
                    Finished := (PtInRect(finish, StartRect) or DoubleClick) and (nvertices > 2);
                until finished;
            end;
        if nvertices > 2 then
            with Info^ do begin
                    PenNormal;
                    OpenRgn;
                    spt.h := x[1];
                    spt.v := y[1];
                    ScreenToOffscreen(spt);
                    MoveTo(spt.h, spt.v);
                    for i := 2 to nvertices do begin
                            pt.h := x[i];
                            pt.v := y[i];
                            ScreenToOffscreen(pt);
                            LineTo(pt.h, pt.v);
                        end;
                    LineTo(spt.h, spt.v);
                    case SelectionMode of
                        NewSelection:
                            CloseRgn(osroiRgn);
                        AddSelection:
                            begin
                                CloseRgn(TempRgn);
                                if RgnNotTooBig(osroiRgn, TempRgn) then
                                    UnionRgn(osroiRgn, TempRgn, osroiRgn);
                            end;
                        SubSelection:
                            begin
                                CloseRgn(TempRgn);
                                if RgnNotTooBig(osroiRgn, TempRgn) then
                                    DiffRgn(osroiRgn, TempRgn, osroiRgn);
                            end;
                    end;
                    RoiShowing := true;
                    roiType := RgnRoi;
                    osroiRect := osroiRgn^^.rgnBBox;
                    roiRect := osroiRect;
                    OffscreenToScreenRect(roiRect);
                    UpdatePicWindow;
                    if PerimeterM in measurements then
                        ComputeLength(nvertices, x, y, true)
                    else
                        results.Length := 0.0;
                end
        else
            with info^ do begin
                    RoiShowing := false;
                    RoiType := NoRoi;
                    UpdatePicWindow;
                end;
        if SelectionMode <> NewSelection then
            DisposeRgn(TempRgn);
        WhatToUndo := NothingToUndo;
        measuring := false;
        repeat
        until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
    end;


    procedure FindCurveLength (event: EventRecord);
        var
            Start, p: point;
            nvertices, ff, i, imag: integer;
            x, y: xyArray;
            tPort: GrafPtr;
    begin
        start := event.where;
        x[1] := start.h;
        y[1] := start.v;
        nvertices := 1;
        PenNormal;
        with info^ do begin
                imag := trunc(magnification + 0.5);
                PenSize(imag, imag);
                ff := imag div 2
            end;
        if ff < 1 then
            ff := 1;
        MoveTo(start.h, start.v);
        DoFreehand(nVertices, ff, x, y);
        GetPort(tPort);
        SetPort(GrafPtr(info^.osPort));
        PenNormal;
        PenSize(LineWidth, LineWidth);
        p.h := x[1];
        p.v := y[1];
        ScreenToOffscreen(p);
        MoveTo(p.h, p.v);
        for i := 2 to nvertices do begin
                p.h := x[i];
                p.v := y[i];
                ScreenToOffscreen(p);
                LineTo(p.h, p.v);
            end;
        SetPort(tPort);
        UpdatePicWindow;
        ComputeLength(nvertices, x, y, false);
        if nLengths < MaxLengths then begin
                nLengths := nLengths + 1;
                UnsavedLengths := UnsavedLengths + 1
            end
        else
            beep;
        with results do begin
                PixelLength := length;
                lengths[nLengths] := length;
                TotalLength := TotalLength + length;
            end;
        ShowResults;
        measuring := true;
    end;


    procedure DoMouseDownInWindow (event: EventRecord; WhichWindow: WindowPtr);
        var
            r: rect;
            str: str255;
            hloc, vloc: integer;
            tool: ToolType;
    begin
        if (WindowPeek(WhichWindow)^.WindowKind <> PicKind) then
            exit(DoMouseDownInWindow);
        if Digitizing and isSelectionTool then
            PasteMode := LiveSelection;
        if Digitizing then
            if (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then
                StopDigitizing;
        GlobalToLocal(event.where);
        IsInsertionPoint := false;
        if MouseState <> NotInRoi then
            exit(DoMouseDownInWindow);
        WhatToUndo := UndoEdit;
        if (SelectionMode = NewSelection) and not ((CurrentTool = MagnifyingGlass) or (CurrentTool = Grabber)) then
            KillRoi;
        SetupUndo;
        if SpaceBarDown and (CurrentTool <> TextTool) then
            tool := grabber
        else
            tool := CurrentTool;
        case tool of
            SelectionTool:
                DoObject(SelectionRect, event);
            OvalSelectionTool:
                DoObject(SelectionOval, event);
            RoundedRectTool:
                DoObject(RoundedRect, event);
            MagnifyingGlass:
                Zoom(event);
            Grabber:
                Scroll(event);
            Pencil, Brush, Eraser:
                DoBrush(event);
            AirBrushTool:
                DoAirBrush(event);
            ruler:
                if OptionKeyDown then
                    FindCurveLength(event)
                else
                    DoObject(LengthObj, event);
            PaintBucket:
                AreaFill(event);
            PolygonTool, FreehandTool:
                MakePolygon(event);
            TextTool:
                DoText(event.where);
            PlotTool:
                DoObject(PlotLine, event);
            PickerTool:
                if BitAnd(Event.modifiers, OptionKey) = OptionKey then
                    GetBackgroundColor(event)
                else
                    GetForegroundColor(event);
            PointingTool:
                DoPoints(event);
            AngleTool:
                FindAngle(event);
            Wand:
                begin
                    if Digitizing then
                        StopDigitizing;
                    AutoOutline(event.where);
                end;
            otherwise
                beep;
        end;
    end;


    procedure DoMouseDownInTools (loc: point);
        var
            r: rect;
            tPort: GrafPtr;
            OddTool, DoubleClick: boolean;
            ToolNum, i: integer;
    begin
        GetPort(tPort);
        SetPort(ToolWindow);
        GlobalToLocal(loc);
        if loc.v <= StartOfLines then begin
                PreviousTool := CurrentTool;
                OddTool := loc.h < tmiddle;
                ToolNum := (loc.v div tmiddle) * 2;
                if not OddTool then
                    ToolNum := ToolNum + 1;
                CurrentTool := ToolType(ToolNum);
                isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = RoundedRectTool);
                DoubleClick := (TickCount - ToolTime) < GetDblTime;
                ToolTime := TickCount;
                InvalRect(ToolRect[CurrentTool]);
                InvalRect(ToolRect[PreviousTool]);
                IsInsertionPoint := false;
                if DoubleClick and (CurrentTool = PreviousTool) then
                    case CurrentTool of
                        MagnifyingGlass:
                            Unzoom;
                        SelectionTool:
                            begin
                                StopDigitizing;
                                SelectAll(true);
                            end;
                        AirbrushTool:
                            SetAirbrushSize;
                        Brush:
                            SetBrushSize;
                        ruler:
                            SetScale;
                        PolygonTool:
                            DoMeasurementOptions;
                        FreehandTool:
                            Calibrate;
                        PlotTool:
                            DoProfilePlotOptions;
                        eraser:
                            if info <> NoInfo then begin
                                    KillRoi;
                                    WhatToUndo := UndoClear;
                                    SetupUndo;
                                    StopDigitizing;
                                    SelectAll(false);
                                    DoOperation(eraseOp);
                                end;
                        LutTool, Wand:
                            if Thresholding then
                                StopThresholding
                            else
                                StartThresholding;
                        PickerTool:
                            if info^.LutMode <> ColorPalette then begin  {Switch to pseudocolor mode}
                                    StopThresholding;
                                    UpdateColors;
                                    CurrentTool := LutTool;
                                    InvalRect(ToolRect[CurrentTool]);
                                end
                            else
                                ResetGrayMap;
                        otherwise
                    end; {case}
                if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then
                    KillRoi;
                if (CurrentTool = SelectionTool) or (CurrentTool = ruler) or (CurrentTool = PointingTool) then
                    ShowResults;
                StretchMode := false;
            end
        else begin
                for i := 1 to nLineTypes do begin
                        r := lines[i];
                        with r do begin
                                left := left - 13;
                                top := top - 2;
                                right := right + 2;
                                bottom := bottom + 2;
                            end;
                        if i = 1 then
                            with r do
                                top := top - 7;
                        if PtInRect(loc, r) then begin
                                with lines[i] do
                                    LineWidth := bottom - top;
                                LineIndex := i;
                            end;
                    end;
                EraseRect(CheckRect);
                InvalRect(CheckRect);
            end;
        SetPort(tPort);
    end;


    procedure RotateColors;
        var
            tPort: GrafPtr;
            vstart, i, j, delta: integer;
            loc: point;
            TempTable: MyCSpecArray;
    begin
        with info^ do begin
                getPort(tPort);
                SetPort(LUTWindow);
                GetMouse(loc);
                vstart := loc.v;
                repeat
                    GetMouse(loc);
                    delta := vstart - loc.v;
                    for i := 1 to 254 do begin {0 is resevred for white and 255 for black}
                            j := i + delta;
                            if j > 254 then
                                j := j - 254;
                            if j > 254 then
                                j := 254;
                            if j < 1 then
                                j := j + 254;
                            if j < 1 then
                                j := 1;
                            TempTable[i] := cTable[j]
                        end;
                    cTable := TempTable;
                    LoadLUT(cTable);
                    vstart := loc.v;
                until not button;
                SetPort(tPort);
            end;
    end;


    procedure UpdateThreshold;
        var
            tPort: GrafPtr;
            loc: point;
            vloc, ThresholdWidth, SaveVLoc, delta: integer;
            UpdateStart: boolean;
            cvalue: extended;
    begin
        if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin
                ValuesMode := IndexValue;
                DrawLabels;
                GetPort(tPort);
                SetPort(LUTWindow);
                GetMouse(loc);
                SaveVLoc := loc.v;
                if SaveVLoc > 255 then
                    SaveVLoc := 255;
                while button do begin
                        GetMouse(loc);
                        vloc := loc.v;
                        if vloc > 255 then
                            vloc := 255;
                        if vloc <= 0 then
                            vloc := 0;
                        ThresholdWidth := ThresholdEnd - ThresholdStart + 1;
                        delta := vloc - SaveVLoc;
                        SaveVLoc := vloc;
                        UpdateStart := vloc <= (ThresholdStart + ThresholdWidth div 3);
                        if UpdateStart then begin
                                ThresholdStart := vloc;
                                if ThresholdStart < 1 then
                                    ThresholdStart := 1
                            end
                        else begin
                                ThresholdEnd := ThresholdEnd + delta;
                                if ThresholdEnd > 254 then
                                    ThresholdEnd := 254;
                                ThresholdStart := ThresholdEnd - ThresholdWidth + 1;
                                if ThresholdStart < 1 then
                                    ThresholdStart := 1;
                            end;
                        if ThresholdStart > ThresholdEnd then
                            ThresholdStart := ThresholdEnd;
                        DrawThreshold;
                        if UpdateStart then
                            vloc := ThresholdStart
                        else
                            vloc := ThresholdEnd;
                        if info^.calibrated then
                            cvalue := value[vloc]
                        else
                            cvalue := noValue;
                        Show1Value(vloc, cvalue)
                    end;
                SetPort(tPort);
            end
        else if CurrentTool = PickerTool then
            EditThresholdColor;
    end;


    function GetColorFromPalette (DoubleClick: boolean): integer;
        var
            tPort: GrafPtr;
            mloc, color, i: integer;
            loc: point;
    begin
        getPort(tPort);
        SetPort(LUTWindow);
        GetMouse(loc);
        if loc.v > 255 then begin
                color := 0;
                for i := 1 to nExtraColors + 2 do
                    if PtInRect(loc, ExtraColorsRect[i]) then
                        Color := ExtraColorsEntry[i];
                if DoubleClick then
                    EditExtraColors(color);
                GetColorFromPalette := color;
            end
        else
            GetColorFromPalette := loc.v;
        SetPort(tPort);
    end;


    procedure DoMouseDownInLUT (event: EventRecord);
        var
            tPort: GrafPtr;
            loc: point;
            MidPoint, mloc, i, color: integer;
            DoubleClick: boolean;
    begin
        with info^ do begin
                if CurrentTool = PickerTool then
                    DoubleClick := (TickCount - LutTime) < GetDblTime
                else
                    DoubleClick := false;
                LutTime := TickCount;
                if (CurrentTool <> LutTool) and (CurrentTool <> Wand) then begin
                        color := GetColorFromPalette(DoubleClick);
                        if (CurrentTool = eraser) or OptionKeyDown then
                            SetBackgroundColor(color)
                        else
                            SetForegroundColor(color);
                        if not DoubleClick then
                            exit(DoMouseDownInLUT);
                    end;
                if Thresholding then begin
                        UpdateThreshold;
                        exit(DoMouseDownInLUT)
                    end;
                if nColors = 0 then
                    exit(DoMouseDownInLUT);
                if (LUTMode <> ColorPalette) and not DoubleClick then begin
                        if DeltaX <> 0 then
                            RotateColors;
                        exit(DoMouseDownInLUT)
                    end;
                if (CurrentTool = PickerTool) and DoubleClick then begin
                        if LUTMode <> ColorPalette then
                            exit(DoMouseDownInLUT);
                        EditColor;
                        exit(DoMouseDownInLUT)
                    end;
                GetPort(tPort);
                SetPort(LUTWindow);
                repeat
                    GetMouse(loc);
                    if loc.v <= 255 then begin
                            mloc := 255 - loc.v;
                            MidPoint := ColorStart + (nColors * ColorWidth) div 2;
                            if mloc < MidPoint then begin
                                    ColorStart := mloc;
                                    if ColorStart < 0 then
                                        ColorStart := 0
                                end
                            else begin
                                    ColorWidth := (mloc - ColorStart) div ncolors;
                                    if ColorWidth < 1 then
                                        ColorWidth := 1;
                                end;
                            UpdateColors;
                        end;
                until not Button;
                SetPort(tPort);
            end; {with}
    end;


    procedure DoZoomIn;
        var
            trect: rect;
            ignore: boolean;
    begin
        with info^ do begin
                MoveWindow(wptr, PicWindowLeft, PicWindowTop, true);
                SetRect(trect, 0, 0, ScreenWidth, ScreenHeight);
                ZoomImageWindow(trect);
                wrect := trect;
                SizeWindow(wptr, trect.right, trect.bottom, true);
            end;
    end;


    procedure DoDrag (WhichWindow: WindowPtr; loc: point);
        var
            WinRect, DragBounds: rect;
            kind: integer;
    begin
        kind := WindowPeek(WhichWindow)^.WindowKind;
        if (kind = PicKind) and (info^.PictureType = ScionType) then
            exit(DoDrag);
        DragBounds := ScreenBits.bounds;
        DragWindow(WhichWindow, loc, DragBounds);
        if WhichWindow = ResultsWindow then
            ShowResults;
    end;


    procedure FindWhatToPrint;
        var
            kind: integer;
            WhichWindow: WindowPtr;
    begin
        WhatToPrint := NothingToPrint;
        WhichWindow := FrontWindow;
        kind := WindowPeek(WhichWindow)^.WindowKind;
        if (kind = PicKind) and info^.RoiShowing and measuring then
            kind := ResultsKind;
        case kind of
            PicKind:
                if info^.RoiShowing then
                    WhatToPrint := PrintSelection
                else
                    WhatToPRint := PrintImage;
            HistoKind:
                WhatToPrint := PrintHistogram;
            ProfilePlotKind, CalibrationPlotKind:
                WhatToPrint := PrintPlot;
            ResultsKind:
                if (CurrentTool = ruler) and (nLengths > 0) then
                    WhatToPrint := PrintLengths
                else if (CurrentTool = PointingTool) and (nPoints > 0) then
                    WhatToPrint := PrintPoints
                else if nAreas > 0 then
                    WhatToPrint := PrintAreas;
            otherwise
                ;
        end;
        if (WhatToPrint = NothingToPRint) and (info <> NoInfo) then
            WhatToPrint := PrintImage;
    end;


    procedure UpdateFileMenu;
        var
            ShowItems, isSelection: boolean;
            i: integer;
            str, str2: str255;
            fwptr: WindowPtr;
            kind: integer;
    begin
        ShowItems := Info <> NoInfo;
        fwptr := FrontWindow;
        kind := WindowPeek(fwptr)^.WindowKind;
        SetMenuItem(FileMenuH, 4, ShowItems or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind));
        with info^ do
            isSelection := RoiShowing and (RoiType = RectRoi);
        if isSelection then begin
                SetItem(FileMenuH, 7, 'Save Selection As TIFF╔');
                SetItem(FileMenuH, 8, 'Save Selection As PICT╔');
            end
        else begin
                SetItem(FileMenuH, 7, 'Save As TIFF╔');
                SetItem(FileMenuH, 8, 'Save As PICT╔');
            end;
        for i := 6 to 8 do
            SetMenuItem(FileMenuH, i, ShowItems);
        if isSelection then
            str := 'Duplicate Selection'
        else
            str := 'Duplicate';
        SetItem(FileMenuH, 12, str);
        for i := 11 to 13 do
            SetMenuItem(FileMenuH, i, ShowItems);
        with info^ do
            if (PictureType <> pdp11) and (PictureType <> normal) and (PictureType <> PictFile) and (PictureType <> TiffFile) and (PictureType <> InvertedTIFF) then
                SetMenuItem(FileMenuH, 11, false);
        FindWhatToPrint;
        case WhatToPrint of
            NothingToPrint:
                str := '';
            PrintImage:
                str := 'Image';
            PrintSelection:
                str := 'Selection';
            PrintPlot:
                str := 'Plot';
            PrintHistogram:
                str := 'Histogram';
            PrintAreas:
                str := 'Measurements';
            PrintLengths:
                str := 'Lengths';
            PrintPoints:
                str := 'Points';
        end;
        SetItem(FileMenuH, 17, concat('Print ', str, '╔'));
        SetMenuItem(FileMenuH, 17, WhatToPrint <> NothingToPrint);
        SetMenuItem(FileMenuH, 19, info^.RoiShowing);
    end;


    procedure UpdateMenus;
    begin
        UpdateFileMenu;
        UpdateEditMenu;
        UpdateOptionsMenu;
        UpdateFunctionsMenu;
        UpdateAnalysisMenu;
    end;


    procedure CloseAll;
    FORWARD;


    procedure DoMouseDown (event: EventRecord);
        var
            WhichWindow: WindowPtr;
            ThePart, ignore: integer;
    begin
        ThePart := FindWindow(event.where, WhichWindow);
        case ThePart of
            InDesk:
                ;
            InMenuBar:
                begin
                    UpdateMenus;
                    CheckWindowsMenuItem;
                    DoMenuEvent(MenuSelect(event.where));
                end;
            InSysWindow:
                SystemClick(Event, WhichWindow);
            InContent:
                begin
                    if WhichWindow = ToolWindow then begin
                            DoMouseDownInTools(event.where);
                            exit(DoMouseDown);
                        end;
                    if WhichWindow = GrayMapWindow then begin
                            DoMouseDownInGrayMap;
                            exit(DoMouseDown)
                        end;
                    if WhichWindow = LUTWindow then begin
                            DoMouseDownInLUT(event);
                            exit(DoMouseDown)
                        end;
                    if WhichWindow = PasteControl then begin
                            DoMouseDownInPasteControl(event.where);
                            exit(DoMouseDown)
                        end;
                    if WhichWindow <> FrontWindow then
                        SelectWindow(WhichWindow)
                    else
                        DoMouseDownInWindow(Event, WhichWindow);
                end;
            InDrag:
                DoDrag(WhichWindow, event.where);
            InGrow:
                DoGrow(WhichWindow, event);
            InGoAway:
                if TrackGoAway(WhichWindow, event.where) then
                    if OptionKeyDown then
                        CloseAll
                    else begin
                            StopDigitizing;
                            ignore := CloseAWindow(WhichWindow);
                        end;
            InZoomIn, InZoomOut:
                begin
                    ScaleToFit;
                    if info^.ScaleToFitWindow then
                        DoZoomIn;
                end;
        end;
    end;


    procedure NudgeRoi (key: integer);
        var
            dh, dv: integer;
    begin
        with info^ do begin
                if not RoiShowing then
                    exit(NudgeRoi);
                case key of
                    LeftArrow:
                        begin
                            dh := -1;
                            dv := 0
                        end;
                    RightArrow:
                        begin
                            dh := 1;
                            dv := 0
                        end;
                    UpArrow:
                        begin
                            dh := 0;
                            dv := -1
                        end;
                    DownArrow:
                        begin
                            dh := 0;
                            dv := 1
                        end;
                end;
                OffsetRgn(osroiRgn, dh, dv);
                osroiRect := osroiRgn^^.rgnBBox;
                roiRect := osroiRect;
                OffscreenToScreenRect(roiRect);
                RoiNudged := true;
            end;
    end;


    procedure DoKeyDown (event: EventRecord);
        var
            Ch: char;
            ich: integer;
    begin
        Ch := chr(BitAnd(Event.message, 255));
        ich := ord(ch);
        if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin
                UpdateMenus;
                CheckWindowsMenuItem;
                DoMenuEvent(MenuKey(Ch));
                exit(DoKeyDown)
            end;
        if CurrentTool = TextTool then
            DrawCharacter(ch)
        else if ch = BackSpace then begin
                if OpPending and (CurrentOp = PasteOp) then begin
                        OpPending := false;
                        KillRoi;
                    end
                else
                    DoClear
            end
        else if (ich >= LeftArrow) and (ich <= DownArrow) then
            NudgeRoi(ich);
    end;


    procedure ActivateWindow;
    begin
        with info^ do begin
                SetPort(info^.wptr);
                IsInsertionPoint := false;
                WhatToUndo := NothingToUndo;
                DrawLabels;
                MouseState := NotInRoi;
            end;
    end;


    procedure DoActivate (event: EventRecord);
        var
            WhichWindow: WindowPtr;
            Activating, SwitchingWindows, isOK: boolean;
            I, kind: integer;
            NewInfo: InfoPtr;
    begin
        WhichWindow := WindowPtr(event.message);
        kind := WindowPeek(WhichWindow)^.WindowKind;
        Activating := odd(event.modifiers);
        if kind = PicKind then begin
                if Activating then begin
                        NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon);
                        SwitchingWindows := NewInfo <> Info;
                        if SwitchingWindows then begin
                                StopDigitizing;
                                SaveRoi;
                                StopThresholding;
                            end;
                        Info := NewInfo;
                        if SwitchingWindows then
                            ActivateWindow
                        else
                            SetPort(info^.wptr);
                        with info^ do begin
                                if (LutMode = GrayScale) or (LutMode = CustomGrayscale) then
                                    DrawGrayMap;
                                if not UndoFromClip then
                                    ShowRoi;
                                LoadLUT(cTable);
                            end;
                        GenerateValues;
                    end
                else
                    KillOperation; {Deactivate}
            end;
        if not activating then begin
                WhichWindow := FrontWindow;
                kind := WindowPeek(WhichWindow)^.WindowKind;
                if kind < 0 then
                    ConvertClipboard; {DA has become active}
            end;
    end;


    procedure DoUpdate (event: EventRecord);
        var
            WhichWindow: WindowPtr;
            SaveInfo: InfoPtr;
            kind: integer;
    begin
        WhichWindow := WindowPtr(event.message);
        kind := WindowPeek(WhichWindow)^.WindowKind;
        BeginUpdate(WhichWindow);
        case kind of
            Pickind:
                begin
                    SaveInfo := info;
                    Info := pointer(WindowPeek(WhichWindow)^.RefCon);
                    if info <> NoInfo then begin
                            UpdatePicWindow;
                            DrawMyGrowIcon(info^.wptr);
                        end
                    else
                        beep;
                    info := SaveInfo;
                end;
            ToolKind:
                DrawTools;
            GrayMapKind:
                DrawGrayMap;
            LUTKind:
                DrawLUT;
            ResultsKind:
                begin
                    DrawLabels;
                    if GetResultsType <> NoResults then
                        ShowResults;
                end;
            HistoKind:
                DrawHistogram;
            ProfilePlotKind, CalibrationPlotKind:
                DrawPlot;
            PasteControlKind:
                DrawPasteControl;
        end;
        EndUpdate(WhichWindow);
    end;


    procedure DoDiskInsert (event: EventRecord);
{ Process disk insertion event, check for damaged or uninitialized disks. }
        var
            p: point;
            intjunk: integer;
    begin
        if (HiWord(event.message) <> NoErr) then begin
                DiLoad;
                SetPt(p, 100, 80);
                intjunk := DiBadMount(p, event.message);
                DiUnload;
            end;
    end;


    function HandleEvents: boolean;
        var
            Event: EventRecord;
            result: boolean;
            theDialog: DialogPtr;
            ItemHit: integer;
    begin
        if GetNextEvent(EveryEvent, Event) then begin
                case Event.what of
                    KeyDown, AutoKey:
                        DoKeyDown(Event);
                    MouseDown:
                        DoMouseDown(Event);
                    ActivateEvt:
                        DoActivate(Event);
                    DiskEvt:
                        DoDiskInsert(Event);
                    UpdateEvt:
                        DoUpdate(Event);
                    otherwise {Do nothing}
                end;
                HandleEvents := true
            end
        else
            HandleEvents := false;
    end;


    procedure ShowInsertionPoint;
        var
            tRect: rect;
            Loc: point;
            height, imag: integer;
    begin
        if not isInsertionPoint then
            exit(ShowInsertionPoint);
        if (TickCount mod (BlinkTime * 2)) < BlinkTime then
            exit(ShowInsertionPoint);
        if info = NoInfo then
            exit(ShowInsertionPoint);
        Loc := InsertionPoint;
        OffscreenToScreen(loc);
        with info^, tRect do begin
                imag := trunc(magnification + 0.5);
                height := CurrentSize * imag;
                height := height - height div 4;
                left := loc.h;
                bottom := loc.v - imag + 1;
                top := bottom - height;
                right := left + 1;
                PenNormal;
                PenSize(imag, imag);
                PenMode(PatXor);
                FrameRect(tRect);
                ticks := TickCount + 3;
                repeat
                until TickCount > ticks;
                FrameRect(tRect);
            end;
    end;


    procedure DrawROI;
        var
            tPort: GrafPtr;
            tRect: rect;
            SaveUndoFromClip: boolean;
            RoiStretchHandle: rect;
    begin
        with Info^ do
            if RoiShowing then begin
                    if OpPending then
                        DoOperation(CurrentOp);
                    GetPort(tPort);
                    SetPort(GrafPtr(Info^.osPort));
                    PenNormal;
                    if not ((MouseState = DownInRoi) and OpPending) then
                        if PicSize <= UndoBufSize then begin
                                with info^.osPort^ do begin
                                        fgColor := BlackC;
                                        bkColor := WhiteC;
                                    end;
                                if RoiType = RectRoi then begin
                                        with osroiRect do begin
                                                SetRect(RoiStretchHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom);
                                                if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then
                                                    PaintRect(RoiStretchHandle);
                                            end;
                                    end;
                                PatIndex := (PatIndex + 1) mod 8;
                                PenPat(pat[PatIndex]);
                                FrameRgn(osroiRgn);
                                with info^.osPort^ do begin
                                        fgColor := ForegroundColor;
                                        bkColor := BackgroundColor;
                                    end;
                            end;
                    if PicSize > UndoBufSize then begin
                            if magnification < 1.0 then
                                PenSize(2, 2);
                            PatIndex := (PatIndex + 1) mod 8;
                            PenPat(pat[PatIndex]);
                            PenMode(PatXor);
                            FrameRgn(osroiRgn);
                            if MouseState = DownInRoi then begin
                                    UnionRect(RoiRect, OldRoiRect, tRect);
                                    UpdateScreen(tRect);
                                end
                            else
                                UpdateScreen(RoiRect);
                            FrameRgn(osroiRgn);
                        end
                    else begin
                            tRect := RoiRect;
                            if MouseState = DownInRoi then
                                UnionRect(RoiRect, OldRoiRect, tRect)
                            else if RoiNudged then begin
                                    tRect := osroiRect;
                                    InsetRect(tRect, -2, -2);
                                    OffscreenToScreenRect(tRect);
                                    RoiNudged := false;
                                end;
                            UpdateScreen(tRect);
                            SaveUndoFromClip := UndoFromClip;
                            UndoFromClip := false;
                            Undo;
                            UndoFromClip := SaveUndoFromClip;
                        end;
                    SetPort(tPort);
                end; {if roi showing}
    end;


    procedure MoveRoi (loc, osloc: point);
        var
            osdh, osdv: integer;
    begin
        with info^ do begin
                osdh := osloc.h - osMouseDownLoc.h;
                osdv := osloc.v - osMouseDownLoc.v;
                if RoiMovementState = Constrained then begin
                        if osdv <> 0 then
                            RoiMovementState := ConstrainedV
                        else if osdh <> 0 then
                            RoiMovementState := ConstrainedH
                    end;
                if RoiMovementState = ConstrainedH then
                    osdv := 0
                else if RoiMovementState = ConstrainedV then
                    osdh := 0;
                if not OpPending then
                    with osroiRect do begin
                            if (left + osdh < 0) and not StretchMode then
                                osdh := -left;
                            if (top + osdv < 0) and not StretchMode then
                                osdv := -top;
                            if right + osdh > PicRect.right then
                                osdh := PicRect.right - right;
                            if bottom + osdv > PicRect.bottom then
                                osdv := PicRect.bottom - bottom;
                        end;
                OldRoiRect := RoiRect;
                if StretchMode then begin
                        measuring := false;
                        if ValuesMode <> WidthValues then begin
                                ValuesMode := WidthValues;
                                DrawLabels;
                            end;
                        with osroiRect do begin
                                right := right + osdh;
                                if right < left + 2 then
                                    right := left + 2;
                                bottom := bottom + osdv;
                                if bottom < top + 2 then
                                    bottom := top + 2;
                                Show2Values(right - left, bottom - top);
                                MakeRegion;
                            end
                    end
                else begin
                        if ValuesMode <> PixelValues then begin
                                ValuesMode := PixelValues;
                                DrawLabels;
                            end;
                        OffsetRgn(osroiRgn, osdh, osdv);
                        with osroiRect do
                            Show3Values(left, top, 0);
                    end;
                osroiRect := osroiRgn^^.rgnBBox;
                roiRect := osroiRect;
                OffscreenToScreenRect(roiRect);
                MouseDownLoc := loc;
                osMouseDownLoc := osloc;
            end;
    end;


    procedure SelectCursor;
        var
            loc, osloc, gloc: point;
            where, kind, i, color, x, y, margin: integer;
            WhichWindow: WindowPtr;
            MouseInRoi: boolean;
            tPort: GrafPtr;
            fwptr: WindowPtr;
            cvalue, xscale: extended;
            RoiStretchHandle: rect;
            MovingRoi: boolean;
            xvalue: integer;
    begin
        if PasteControl <> nil then begin
                fwptr := FrontWindow;
                if WindowPeek(fwptr)^.WindowKind <> PasteControlKind then
                    BringToFront(PasteControl);
            end;
        GetPort(tPort);
        SetPort(ScreenPort);
        GetMouse(gloc);
        loc := gloc;
        where := FindWindow(gloc, WhichWindow);
        kind := WindowPeek(WhichWindow)^.WindowKind;
        if kind < 0 then begin
                SetPort(tPort);
                exit(SelectCursor)
            end; {System Window}
        if where <> InContent then begin
                InitCursor;
                SetPort(tPort);
                exit(SelectCursor)
            end;
        case kind of
            PicKind:
                begin
                    if Info = NoInfo then begin
                            SetPort(tPort);
                            exit(SelectCursor)
                        end;
                    SetPort(info^.wptr);
                    GlobalToLocal(loc);
                    osloc := loc;
                    ScreenToOffscreen(osloc);
                    MovingRoi := false;
                    with info^ do begin
                            SelectionMode := NewSelection;
                            if RoiShowing and isSelectionTool then begin
                                    if OptionKeyDown then
                                        SelectionMode := SubSelection
                                    else if ControlKeyDown then
                                        SelectionMode := AddSelection;
                                end;
                            if RoiShowing and (SelectionMode = NewSelection) then
                                MouseInRoi := PtInRgn(osloc, osroiRgn)
                            else
                                MouseInRoi := false
                        end; {with}
                    if MouseInRoi or (MouseState = DownInRoi) then begin
                            if MouseState = NotInRoi then
                                MouseState := InRoi;
                            InitCursor;
                            if button then begin
                                    if MouseState = InRoi then begin
                                            if OpPending and (CurrentOp <> PasteOp) then
                                                SetupUndo;
                                            MouseState := DownInRoi;
                                            MouseDownLoc := loc;
                                            osMouseDownLoc := osloc;
                                            with info^ do
                                                if RoiType = RectRoi then begin
                                                        if magnification > 1.0 then
                                                            margin := 0
                                                        else
                                                            margin := 2;
                                                        with osroiRect do
                                                            SetRect(RoiStretchHandle, right - RoiHandleSize - margin, bottom - RoiHandleSize - margin, right, bottom);
                                                        StretchMode := PtInRect(osloc, RoiStretchHandle);
                                                    end;
                                            if ShiftKeyDown then
                                                RoiMovementState := Constrained
                                            else
                                                RoiMovementState := Unconstrained;
                                        end;
                                    MoveRoi(loc, osloc);
                                    MovingRoi := true;
                                end
                            else
                                MouseState := InRoi
                        end
                    else begin
                            MouseState := NotInRoi;
                            if SpaceBarDown and (CurrentTool <> TextTool) then
                                SetCursor(ToolCursor[Grabber])
                            else if SelectionMode = AddSelection then
                                SetCursor(CrossPlusCursor)
                            else if SelectionMode = SubSelection then
                                SetCursor(CrossMinusCursor)
                            else if (CurrentTool = MagnifyingGlass) and OptionKeyDown then
                                SetCursor(GlassMinusCursor)
                            else
                                SetCursor(ToolCursor[CurrentTool]);
                        end;
                    if not MovingRoi then begin
                            if ValuesMode <> PixelValues then begin
                                    ValuesMode := PixelValues;
                                    DrawLabels;
                                end;
                            with osloc do
                                Show3Values(h, v, MyGetPixel(h, v));
                        end;
                end;
            HistoKind:
                begin
                    if ValuesMode <> xyValues then begin
                            ValuesMode := xyValues;
                            DrawLabels;
                        end;
                    SetCursor(ToolCursor[SelectionTool]);
                    SetPort(HistoWindow);
                    GlobalToLocal(loc);
                    Show2Values(loc.h, histogram[loc.h]);
                end;
            ProfilePlotKind, CalibrationPlotKind:
                begin
                    if ValuesMode <> xyValues then begin
                            ValuesMode := xyValues;
                            DrawLabels;
                        end;
                    SetCursor(ToolCursor[SelectionTool]);
                    SetPort(PlotWindow);
                    GlobalToLocal(loc);
                    xscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin);
                    xvalue := trunc((loc.h - PlotLeftMargin) * xscale);
                    if (xvalue >= 0) and (xvalue < PlotWidth) then
                        if kind = CalibrationPlotKind then
                            Show2CalibratedValues(xvalue, xvalue, false)
                        else
                            Show2CalibratedValues(xvalue, PlotData[xvalue], true);
                end;
            LUTKind:
                begin
                    if ValuesMode <> IndexValue then begin
                            ValuesMode := IndexValue;
                            DrawLabels
                        end;
                    SetPort(LUTWindow);
                    GlobalToLocal(loc);
                    if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin
                            if loc.v < 256 then
                                SetCursor(LUTCursor)
                            else
                                InitCursor
                        end
                    else
                        SetCursor(PickerCursor);
                    if loc.v < 256 then begin
                            if info^.calibrated then
                                cvalue := value[loc.v]
                            else
                                cvalue := noValue;
                            Show1Value(loc.v, cvalue);
                        end
                    else begin
                            color := 0;
                            for i := 1 to nExtraColors + 2 do
                                if PtInRect(loc, ExtraColorsRect[i]) then
                                    Color := ExtraColorsEntry[i];
                            if info^.calibrated then
                                cvalue := value[color]
                            else
                                cvalue := noValue;
                            Show1Value(color, cvalue);
                        end;
                end;
            GrayMapKind:
                SetCursor(gmCursor);
            otherwise
                InitCursor;
        end; {case}
        SetPort(tPort);
    end;


    procedure CloseAll;
        var
            i, j, result: integer;
            WPeek, NextWPeek: WindowPeek;
            ignore: boolean;
    begin
        InitCursor;
        WPeek := WindowPeek(FrontWindow);
        StopDigitizing;
        while wpeek <> nil do begin
                NextWPeek := WPeek^.NextWindow;
                if WPeek^.WindowKind = PicKind then begin
                        Info := pointer(WPeek^.RefCon);
                        result := CloseAWindow(info^.wptr);
                        for j := 1 to 2 do
                            ignore := HandleEvents;
                        if result = cancel then begin
                                ActivateWindow;
                                finished := false;
                                exit(CloseAll)
                            end;
                    end;
                wpeek := NextWPeek;
            end;
    end;


    procedure DoStartup;
  {Process Finder startup information}
        var
            message, ndocs, err, i, j: integer;
            DocInfo: AppFile;
            DefaultPalette, OpenedOK: boolean;
            palettename: str255;
            PaletteFile: boolean;
            ignore, PrintDocs: boolean;

        procedure PrintDocument;
            var
                i: integer;
        begin
            WhatToPrint := PrintImage;
            Print(false);
            DoClose;
            for i := 1 to 10 do
                ignore := HandleEvents;
        end;

    begin
        for j := 1 to 10 do
            ignore := HandleEvents;
        PaletteFile := false;
        CountAppFiles(message, ndocs);
        PrintDocs := message = appPrint;
        if ndocs >= 1 then
            for i := 1 to ndocs do begin
                    GetAppFiles(i, DocInfo);
                    with DocInfo do begin
                            if ftype = 'ICOL' then begin
                                    PaletteFile := true;
                                    palettename := docinfo.fname;
                                    ClrAppFiles(i)
                                end;
                            if fType = 'IPIC' then begin
                                    WhatToOpen := OpenImage;
                                    OpenFile(fName, vRefNum);
                                    for j := 1 to 10 do
                                        ignore := HandleEvents;
                                    ClrAppFiles(i);
                                    if PrintDocs then
                                        PrintDocument;
                                end;
                            if fType = 'TIFF' then begin
                                    WhatToOpen := OpenTIFF;
                                    OpenFile(fName, vRefNum);
                                    for j := 1 to 10 do
                                        ignore := HandleEvents;
                                    ClrAppFiles(i);
                                    if PrintDocs then
                                        PrintDocument;
                                end;
                            if fType = 'PICT' then begin
                                    OpenedOK := OpenPICT(fName, vRefNum, false);
                                    for j := 1 to 10 do
                                        ignore := HandleEvents;
                                    ClrAppFiles(i);
                                    if not OpenedOK then
                                        exit(DoStartup);
                                    if PrintDocs then
                                        PrintDocument;
                                end;
                        end; {with}
                end;
        if PaletteFile then
            InitColor(PaletteName, DocInfo.vRefNum);
    end;


    procedure Shutdown;
        var
            AlertID: integer;
    begin
        if (UnsavedAreas > 0) or (UnsavedLengths > 0) or (UnsavedPoints > 0) then begin
                InitCursor;
                AlertID := alert(500, nil);
                if AlertID = CancelResetID then begin
                        finished := false;
                        exit(Shutdown)
                    end;
            end;
        CloseAll;
        ConvertClipboard;
    end;


begin
    Init;
    SetupMenus;
    GetSettings;
    AllocateBuffers;
    GetPictFromScrap;
    DoStartup;
    UnloadSeg(@Init);
{InitUser;}
    repeat
        SystemTask;
        if not HandleEvents then
            if info^.RoiShowing then
                DrawRoi;
        ShowInsertionPoint;
        SelectCursor;
        if Digitizing then begin
                GetFrame;
                if ContinuousHistogram then
                    ShowContinuousHistogram;
            end;
        if Finished then
            Shutdown;
    until finished;
    isOK := LoadCLUTResource(AppleDefaultCLUT);
    RestoreScreen; {Force Finder to redraw color icons}
end.